home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / rehash13.zip / REHASH.BAS next >
BASIC Source File  |  1991-11-04  |  10KB  |  320 lines
  1. DECLARE FUNCTION CalcDays% (D$)
  2. DECLARE FUNCTION ValidUser% (U$, WriteIt%)
  3. DECLARE FUNCTION HashTo% (V$, MaxPos%)
  4.  
  5. '*  REHASH.BAS
  6. '*---------------------------------------------------------------------------
  7. '*
  8. '*  Quick 'N Dirty utility to auto-size/pack a RBBS users file
  9. '*
  10. '*  11-04-91
  11. '*
  12.  
  13.       ON ERROR GOTO 999
  14.       DEFINT A-Z
  15.       DIM DaysPerMonth(12)
  16.  
  17.       CONST FALSE = 0
  18.       CONST TRUE = -1
  19.  
  20.       OPEN "CONS:" FOR OUTPUT AS #10
  21.  
  22.       PRINT #10, "REHASH v1.30 11-04-91, Super-Dooper RBBS Users File Resizer, by Tom Collins"
  23.       PRINT #10,
  24.  
  25.       A$ = COMMAND$
  26.       A$ = UCASE$(LTRIM$(RTRIM$(A$)))
  27.  
  28.       ExemptLevel = 32000
  29.       I = INSTR(A$, "/EL")
  30.       IF I <> 0 THEN
  31.          ExemptLevel = VAL(MID$(A$, I + 3))
  32.       END IF
  33.       OlderThan = 32000
  34.       I = INSTR(A$, "/OT")
  35.       IF I <> 0 THEN
  36.          OlderThan = VAL(MID$(A$, I + 3))
  37.       END IF
  38.       ExtraUsers = 0
  39.       MultiplyFactor! = 1!
  40.       I = INSTR(A$, "/MF")
  41.       IF I <> 0 THEN
  42.          MultiplyFactor! = VAL(MID$(A$, I + 3))
  43.          IF MultiplyFactor! < 1! OR MultiplyFactor! > 10! THEN
  44.             MultiplyFactor! = 1!
  45.          END IF
  46.       END IF
  47.       IF MultiplyFactor! = 1! THEN
  48.          ExtraUsers = 8
  49.       END IF
  50.       I = INSTR(A$, "/EU")
  51.       IF I <> 0 THEN
  52.          X = VAL(MID$(A$, I + 3))
  53.          IF X > 0 THEN
  54.             ExtraUsers = X
  55.          END IF
  56.       END IF
  57.       I = INSTR(A$, "/")
  58.       IF I <> 0 THEN
  59.          A$ = LEFT$(A$, I - 1)
  60.       END IF
  61.       I = INSTR(A$, " ")
  62.       IF A$ = "" OR I = 0 THEN
  63.          PRINT #10, "Usage: REHASH <Messages File> <Users File> [/ELx] [/OTx] [/MFx] [/EUx]"
  64.          PRINT #10, "       /ELx   - Users >= Level x are exempt from packing"
  65.          PRINT #10, "       /OTx   - Remove users who haven't been on in x days"
  66.          PRINT #10, "       /MFx   - Keep file size at least x times what's required (x > 1.0)"
  67.          PRINT #10, "       /EUx   - Leave room for at least x more users"
  68.          END
  69.       END IF
  70.  
  71.       TempFile$ = "$$USERS$.$$$"
  72.  
  73. 100   MsgsFile$ = RTRIM$(LTRIM$(LEFT$(A$, I)))
  74.       OPEN MsgsFile$ FOR RANDOM AS #1 LEN = 128
  75.       FIELD 1, 128 AS M$
  76.  
  77. 110   UsersFile$ = RTRIM$(LTRIM$(MID$(A$, I)))
  78.       OPEN UsersFile$ FOR RANDOM AS #2 LEN = 128
  79.       FIELD 2, 128 AS U$
  80.       UserRecs = LOF(2) \ 128
  81.  
  82.       IF MID$(UsersFile$, 2, 1) = ":" THEN
  83.          TempFile$ = LEFT$(UsersFile$, 2) + TempFile$
  84.       END IF
  85.  
  86.       FOR I = 1 TO 12
  87.          DaysPerMonth(I) = 31
  88.       NEXT
  89.       DaysPerMonth(2) = 28   ' Feb
  90.       DaysPerMonth(4) = 30   ' April
  91.       DaysPerMonth(6) = 30   ' June
  92.       DaysPerMonth(9) = 30   ' Sep
  93.       DaysPerMonth(11) = 30  ' Nov
  94.  
  95.       DaysSince88 = CalcDays(LEFT$(DATE$, 6) + RIGHT$(DATE$, 2))
  96.  
  97. 120   PRINT #10, CHR$(254) + " Reading "; UsersFile$; "...";
  98.       UsersRecsUsed = 0
  99.       TempRecs$ = ""
  100.       ForceRehash = FALSE                           ' v1.30
  101.       FOR I = 1 TO UserRecs
  102.          GET #2, I
  103.          IF ValidUser(U$, WriteIt) THEN
  104.             UserRecsUsed = UserRecsUsed + 1
  105.             TempRecs$ = TempRecs$ + MKI$(I)
  106.          ELSEIF WriteIt = TRUE THEN
  107.             PUT #2, I
  108.             ForceRehash = TRUE                      ' v1.30
  109.          END IF
  110.       NEXT
  111.       PRINT #10, UserRecsUsed; "of"; UserRecs; "Records Used."
  112.  
  113.       IF MultiplyFactor! = 1! THEN
  114.          UserRecsRequired = UserRecsUsed + ExtraUsers
  115.       ELSE
  116.          UserRecsRequired = MultiplyFactor! * UserRecsUsed
  117.          IF UserRecsRequired - UserRecsUsed < ExtraUsers THEN
  118.             UserRecsRequired = UserRecsUsed + ExtraUsers
  119.          END IF
  120.       END IF
  121.  
  122.       FOR I = 3 TO 15
  123.          IF I = 14 THEN
  124.             PRINT #10, CHR$(254) + " Can't Rehash... ";
  125.             CLOSE 2
  126.             GOTO 220
  127.          END IF
  128.          IF 2 ^ I > UserRecsRequired THEN
  129.             UserRecsRequired = 2 ^ I
  130.             EXIT FOR
  131.          END IF
  132.       NEXT
  133.  
  134.       IF UserRecsRequired = UserRecs AND NOT ForceRehash THEN ' v1.30
  135.          PRINT #10, CHR$(254) + " No Resizing Required... ";
  136.          CLOSE 2
  137.          GOTO 220
  138.       END IF
  139.  
  140. 130   IF ForceRehash THEN                                     ' v1.30
  141.          PRINT #10, CHR$(254) + " Rehashing";                 ' v1.30
  142.       ELSE                                                    ' v1.30
  143.          PRINT #10, CHR$(254) + " Resizing";                  ' v1.30
  144.       END IF                                                  ' v1.30
  145.       PRINT #10, " File to"; UserRecsRequired; "Records... "; ' v1.30
  146.  
  147.       Recs$ = TempRecs$
  148.       OPEN TempFile$ FOR RANDOM AS #3 LEN = 128
  149.       FIELD 3, 128 AS T$
  150.  
  151. 140   LSET T$ = SPACE$(128)
  152. 150   FOR I = 1 TO UserRecsRequired
  153.          PUT 3, I
  154.       NEXT
  155.  
  156.       WHILE Recs$ <> ""
  157.          I = CVI(LEFT$(Recs$, 2))
  158.          Recs$ = MID$(Recs$, 3)
  159. 160      GET #2, I
  160.          Z$ = U$
  161.          X = HashTo(Z$, UserRecsRequired)
  162.          IF X = -1 THEN
  163.             PRINT #10, "Failed."
  164. 170         CLOSE 3
  165.             IF UserRecsRequired = 16384 THEN
  166.                PRINT #10, CHR$(254) + " Can't Rehash... ";
  167.                CLOSE 2
  168.                GOTO 220
  169.             END IF
  170.             UserRecsRequired = UserRecsRequired * 2
  171.             GOTO 130
  172.          END IF
  173. '        PRINT #10, "  "; RTRIM$(LEFT$(U$, 31)); ":"; I; "->"; X
  174. 180      LSET T$ = Z$
  175. 190      PUT 3, X
  176.       WEND
  177.  
  178.       CLOSE 2, 3
  179. 200   KILL UsersFile$
  180. 210   NAME TempFile$ AS UsersFile$
  181.  
  182. 220   GET 1, 1
  183.       MID$(M$, 57, 5) = "     "
  184.       MID$(M$, 57, 5) = STR$(UserRecsUsed)
  185. 230   PUT 1, 1
  186. 240   CLOSE 1
  187.  
  188.       PRINT #10, "Done."
  189.       END
  190.  
  191. 999   IF ERL = 100 THEN
  192.          PRINT #10, "Can't Find Messages File '"; MsgsFile$; "'..."
  193.          END
  194.       ELSEIF ERL = 110 THEN
  195.          PRINT #10, "Can't Find Users File '"; UsersFile$; "'..."
  196.          END
  197.       ELSE
  198.          PRINT #10, "Weird Error"; ERR; "at Line"; ERL; "Has Occurred..."
  199.          END
  200.       END IF
  201.  
  202. '*  CALCDAYS
  203. '*----------------------------------------------------------------------------
  204. '*
  205. '*  Calculates the # of days since Jan 1, 1988
  206. '*
  207. '*
  208.       FUNCTION CalcDays (D$)
  209.       SHARED DaysPerMonth()
  210.  
  211.       Month = VAL(MID$(D$, 1, 2))
  212.       Day = VAL(MID$(D$, 4, 2))
  213.       Year = VAL(MID$(D$, 7, 2))
  214.  
  215.       IF Year < 88 THEN
  216.          Year = 88
  217.       END IF
  218.       DaysOld = (Year - 88) * 365
  219.       IF Month > 1 THEN
  220.          FOR I = 1 TO Month - 1
  221.             DaysOld = DaysOld + DaysPerMonth(I)
  222.          NEXT
  223.       END IF
  224.       DaysOld = DaysOld + Day
  225.       CalcDays = DaysOld
  226.       END FUNCTION
  227.  
  228. '*  HASHTO
  229. '*---------------------------------------------------------------------------
  230. '*
  231. '*  Returns the user record to put a given user, or -1 if no more room
  232. '*
  233. '*
  234.       FUNCTION HashTo (V$, MaxPos)
  235.  
  236.       UserName$ = RTRIM$(LEFT$(V$, 31))
  237.       L = LEN(UserName$)
  238.  
  239.       EmptyRec$ = SPACE$(31)
  240.  
  241.       SecondHash = (ASC(MID$(UserName$, 2, 1)) * 10 + 7) MOD MaxPos
  242.  
  243.       PrimeHash = ASC(MID$(UserName$, 1, 1)) * 100
  244.       PrimeHash = PrimeHash + ASC(MID$(UserName$, L / 2 + .1, 1)) * 10
  245.       PrimeHash = PrimeHash + ASC(RIGHT$(UserName$, 1))
  246.       PrimeHash = (PrimeHash MOD MaxPos) + 1
  247.  
  248.       FIELD 3, 128 AS T$
  249.  
  250.       I = PrimeHash
  251.       Found = FALSE
  252.       FOR Count = 1 TO 25
  253. '        IF I <= 0 THEN             ' v1.30
  254. '           EXIT FOR                ' v1.30
  255. '        END IF                     ' v1.30
  256. 300      GET 3, I
  257.          IF LEFT$(T$, 31) = EmptyRec$ THEN
  258.             HashTo = I
  259.             Found = TRUE
  260.             EXIT FOR
  261.          ELSEIF LEFT$(T$, 31) = LEFT$(V$, 31) THEN ' duplicate   ' v1.30
  262.             Month1 = VAL(MID$(V$, 106, 2))
  263.             Month2 = VAL(MID$(T$, 106, 2))
  264.             Day1 = VAL(MID$(V$, 109, 2))
  265.             Day2 = VAL(MID$(T$, 109, 2))
  266.             Year1 = VAL(MID$(V$, 112, 2))
  267.             Year2 = VAL(MID$(T$, 112, 2))
  268.             IF Year2 > Year1 OR (Year2 = Year1 AND Month2 > Month1) OR (Year2 = Year1 AND Month2 = Month1 AND Day2 > Day1) THEN
  269.                V$ = T$
  270.             END IF
  271.             HashTo = I
  272.             Found = TRUE
  273.             EXIT FOR
  274.          END IF
  275.          I = I + SecondHash
  276.          IF I > MaxPos - 1 THEN
  277.             I = I - MaxPos
  278.             WHILE I <= 0                  ' v1.30
  279.                 I = I + SecondHash        ' v1.30
  280.             WEND                          ' v1.30
  281.          END IF
  282.       NEXT
  283.  
  284.       IF NOT Found THEN
  285.          HashTo = -1
  286.       END IF
  287.       END FUNCTION
  288.  
  289. '*  VALIDUSER
  290. '*---------------------------------------------------------------------------
  291. '*
  292. '*  Returns TRUE or FALSE depending on whether a given user should
  293. '*  be kept in the users file.
  294. '*
  295.       FUNCTION ValidUser (U$, WriteIt)
  296.       SHARED OlderThan, ExemptLevel
  297.       SHARED DaysSince88
  298.       B$ = LEFT$(U$, 31)
  299.       ValidUser = TRUE
  300.       WriteIt = FALSE
  301.       IF MID$(B$, 2, 12) = "deleted user" OR LEFT$(B$, 7) = "NEWUSER" THEN
  302.          ValidUser = FALSE
  303.          MID$(U$, 1, 31) = SPACE$(31)
  304.          WriteIt = TRUE
  305.       ELSEIF B$ = SPACE$(31) OR B$ = STRING$(31, 0) THEN
  306.          ValidUser = FALSE
  307.       ELSE
  308.          DaysOld = DaysSince88 - CalcDays(MID$(U$, 106, 8))
  309.          IF DaysOld > OlderThan THEN
  310.             UserSecLevel = CVI(MID$(U$, 47, 2))
  311.             IF UserSecLevel < ExemptLevel THEN
  312.                ValidUser = FALSE
  313.                MID$(U$, 1, 31) = SPACE$(31)
  314.                WriteIt = TRUE
  315.             END IF
  316.          END IF
  317.       END IF
  318.       END FUNCTION
  319.  
  320.